R Notebook

library(pacman)
pacman::p_load(pheatmap, igraph, heatmaply)

library(igraph)
posTraits <- read.csv("~/Google Drive/Volumes/Research Project/Trait Network_Behaviral/generating network/output/allPosCents.csv")
negTraits <- read.csv("~/Google Drive/Volumes/Research Project/Trait Network_Behaviral/generating network/output/allNegCents.csv")

posDf <- read.csv("~/Google Drive/Volumes//Research Project/Trait Network_Behaviral/generating network/output/adjacencyMatrix_p.csv")
posMat <- as.matrix(posDf)
posGraph <- graph.adjacency(posMat)

negDf <- read.csv("~/Google Drive/Volumes//Research Project/Trait Network_Behaviral/generating network/output/adjacencyMatrix_n.csv")
negMat <- as.matrix(negDf)
negGraph <- graph.adjacency(negMat)

simPos <- as.matrix(similarity.dice(posGraph))
colnames(simPos) <- posTraits$trait
rownames(simPos) <- posTraits$trait

outphm<-pheatmap(simPos, fontsize_row = 6, fontsize_col = 6, angle_col = 45, angle_row =45, width=100, height = 200 )
heatmaply(normalize(simPos), Rowv=outphm[[1]], Colv=outphm[[2]], revC=TRUE, fontsize_row = 2, fontsize_col = 2, angle_col = 45, angle_row =45,  limits = c(-1, 1), colors = colorRampPalette(rev(brewer.pal(n = 7, name =
  "RdYlBu")))(100) )

words <- c("Sociable","Fun","Witty","Smart","Knowledgeable","Talkative","Disciplined","Extraverted","Charming","Studious","Level-headed","Mature")
test <- simPos[words,words]
library(pheatmap)
outphm<-pheatmap(test, fontsize_row = 6, fontsize_col = 6, angle_col = 45, angle_row =45, width=100, height = 200 )

ggheatmap(
normalize(test), Rowv=outphm[[1]], Colv=outphm[[2]], revC=TRUE, fontsize_row = 12, fontsize_col = 12, angle_col = 45, angle_row =45,  limits = c(-1, 1), colors = colorRampPalette(rev(brewer.pal(n = 7, name =
  "RdYlBu")))(100)
)
ggsave("~/Desktop/posSimMat.png",height=6,width=8,units = "in")

heatmaply(normalize(test), Rowv=outphm[[1]], Colv=outphm[[2]], revC=TRUE, fontsize_row = 12, fontsize_col = 12, angle_col = 45, angle_row =45,  limits = c(-1, 1), colors = colorRampPalette(rev(brewer.pal(n = 7, name =
  "RdYlBu")))(100) )

words <- c("Sociable","Fun","Witty","Smart","Knowledgeable","Talkative","Disciplined","Extraverted","Charming","Studious","Level-headed","Mature")
subsetSimPos <- simPos[words,words]

outgoingwords <-c("Witty","Fun","Sociable","Talkative","Extraverted","Charming")
disciplinewords <- setdiff(words,outgoingwords)

pheatmap(subsetSimPos, fontsize_row = 12, fontsize_col = 12, angle_col = 90, angle_row =45,  limits = c(0, 1), color = colorRampPalette((brewer.pal(n = 7, name =
  "YlOrRd")))(100), border_color = NA, legend=F, treeheight_col=0, treeheight_row=0, file="~/Desktop/test.png")

words <- c("Sociable","Fun","Witty","Smart","Knowledgeable","Talkative","Disciplined","Extraverted","Charming","Studious","Level-headed","Mature")
subsetSimPos <- simPos[words,words]

outgoingwords <-c("Witty","Fun","Sociable","Talkative","Extraverted","Charming")
disciplinewords <- setdiff(words,outgoingwords)

# colnames(subsetSimPos)[which(colnames(subsetSimPos)%in%outgoingwords)] <- paste0(colnames(subsetSimPos)[which(colnames(subsetSimPos)%in%outgoingwords)], " - [68% GP]")
# rownames(subsetSimPos)[which(rownames(subsetSimPos)%in%outgoingwords)] <- paste0(rownames(subsetSimPos)[which(rownames(subsetSimPos)%in%outgoingwords)], " - [68% GP]")
# 
# colnames(subsetSimPos)[which(colnames(subsetSimPos)%in%disciplinewords)] <- paste0(colnames(subsetSimPos)[which(colnames(subsetSimPos)%in%disciplinewords)], " - [32% GP]")
# rownames(subsetSimPos)[which(rownames(subsetSimPos)%in%disciplinewords)] <- paste0(rownames(subsetSimPos)[which(rownames(subsetSimPos)%in%disciplinewords)], " - [32% GP]")

colnames(subsetSimPos)[which(colnames(subsetSimPos)%in%outgoingwords)] <-  " "

colnames(subsetSimPos)[which(colnames(subsetSimPos)%in%disciplinewords)] <- " "

pheatmap(subsetSimPos, fontsize_row = 12, fontsize_col = 12, angle_col = 0, angle_row =45,  limits = c(0, 1), color = colorRampPalette((brewer.pal(n = 7, name =
  "YlOrRd")))(100), border_color = NA, legend=F, treeheight_col=0, treeheight_row=0, file="~/Desktop/test.png")

V(posGraph)$Names <- posTraits$trait
 
outgoingwords <-c("Witty","Fun","Sociable","Talkative","Extraverted","Charming")
disciplinewords <- setdiff(words,outgoingwords)
V(posGraph)$group[which(V(posGraph)$Names%in%outgoingwords)] <- "Low GN"
V(posGraph)$group[which(V(posGraph)$Names%in%disciplinewords)] <- "High GN"

V(posGraph)$Names2[which(V(posGraph)$Names%in%outgoingwords)] <- paste0(outgoingwords,"\n32% GP")#"Low GN"
V(posGraph)$Names2[which(V(posGraph)$Names%in%disciplinewords)] <- paste0(disciplinewords,"\n68% GP")#"High GN"



#FriendlyNet <- ego(subTFGraph.55520, order = 1, nodes = 6, mode = "out",
#  mindist = 0)
subNet <- induced.subgraph(posGraph, vids = which(V(posGraph)$Names%in%c(outgoingwords,disciplinewords)) )

set.seed(2)

library(GGally)

Registered S3 method overwritten by 'GGally':
  method from   
  +.gg   ggplot2

plotOutdegree <- ggnet2(subNet, alpha = 0.75, size = "outdegree", color = "phono", edge.color = "grey", edge.alpha = 0.25, mode = "kamadakawai", layout.exp = .35, directed = TRUE) + 
  guides(color = FALSE, size = FALSE) + geom_text(aes(label = V(subNet)$Names), size = 3.5)

Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> = "none")` instead.

plotOutdegree

set.seed(52)
ggnet2(subNet, directed=TRUE, arrow.size = 3.5, arrow.gap = 0.05, layout.exp = .65, alpha = 1, size = "outdegree", color = "group", palette = "Set2", edge.color = "black", edge.alpha = .75, mode = "fruchtermanreingold", directed = TRUE) + 
  guides(color = FALSE, size = FALSE) + geom_text(aes(label = V(subNet)$Names2), size = 4)

Warning: `guides(<scale> = FALSE)` is deprecated. Please use `guides(<scale> = "none")` instead.

mds.sim <- (1 - simPos) %>%
  cmdscale() %>%
  as_tibble()

Warning: The `x` argument of `as_tibble.matrix()` must have unique column names if `.name_repair` is omitted as of tibble 2.0.0.
Using compatibility `.name_repair`.

inds <- c(which(colnames(simPos)%in%outgoingwords), which(colnames(simPos)%in%disciplinewords))

colnames(mds.sim) <- c("Dim.1", "Dim.2")
ggscatter(mds.sim[inds,], x = "Dim.1", y = "Dim.2", 
          size = 1,
          label = colnames(simPos)[inds],
          repel = TRUE) + xlab("More Group Probable") + ylab("More Group Probable")

library(grid) 
g <- rasterGrob(blues9, width=unit(1,"npc"), height = unit(1,"npc"), 
interpolate = TRUE) 
ggscatter(mds.sim[inds,], x = "Dim.1", y = "Dim.2", 
          size = 1,
          label = colnames(simPos)[inds],
          repel = TRUE) + xlab("Group Characteristics") + ylab("Group Characteristics") +
  scale_x_continuous(breaks = seq(from=-.3,to=.3,by=.3), labels=c("32% Group Probability", "0% Group Probability", "68% Group Probability")) +
    scale_y_continuous(breaks = seq(from=-.5,to=.2,by=.35), labels=c("32% Group Probability", "0% Group Probability", "68% Group Probability"))

#trsup <- data.frame(x=c(-2,-2,2), y=c(-2,2,2))
#trinf <- data.frame(x=c(-2,2,2), y=c(-2,-2,2))

#mds.simZ <- as.data.frame(scale(mds.sim))
mds.simRS <- mds.sim
mds.simRS$Dim.1 <- scales::rescale(mds.sim$Dim.1, to=c(-1,1))
mds.simRS$Dim.2 <- scales::rescale(mds.sim$Dim.2, to=c(-1,1))


trinf <- data.frame(x=c(-5,5,5), y=c(5,5,-5))
trsup <- -trinf

df <- data.frame(x = sample(1:100, 100, replace = FALSE), y = sample(1:100, 100, replace=FALSE))

ggscatter(mds.simRS[inds,], x = "Dim.1", y = "Dim.2", 
          size = 1,
          label = colnames(simPos)[inds],
          repel = TRUE) + geom_polygon(aes(x=x,y=y), data = trsup, fill= "dodgerblue3", alpha = .4) + geom_polygon(aes(x=x,y=y), data = trinf, fill = "#FF000066", alpha = .4) + coord_cartesian(xlim=c(-1.5,1.5), ylim=c(-1.5,1.5)) + xlab("Categories") + ylab("Categories") +
  scale_x_continuous(breaks = seq(from=-1,to=1,by=1), labels=c("Social", " ", "Studious")) +
    scale_y_continuous(breaks = seq(from=-1,to=1,by=1), labels=c("Social", " ", "Studious"))